كتاب / عبد الرزاق + حکكیم 
razaklaam@ gmail.com razakff@live.fr / Jnl‏ 
الموقع / www.razak55.y007.coOm‏ 


بسم الله الرحمن الرحيم 
السلام عليكم ورحمة النته وبركاته 
ees‏ 


-عرض أو استخراج اسم قارىئ الأقراص المضغوطة: 


کود: 
function GetFirstCdRomDrive: string;‏ 
var‏ 
r: LongWord;‏ 
Drives: array[0..128] of char;‏ 
pDrive: pchar;‏ 
begin‏ 
Result := '';‏ 
r := GetLogicalDriveStrings (sizeof (Drives), Drives);‏ 
if r = 0 then exit;‏ 
if r > sizeof (Drives) then‏ 
raise‏ 
Exception. Create (SysErrorMessage (ERROR_OUTOFMEMORY) ) ;‏ 
pDrive := Drives;‏ 
while pDrive* <> #0 do begin‏ 
if GetDriveType (pDrive) = DRIVE_CDROM then begin‏ 
Result := pDrive;‏ 
exit;‏ 
end;‏ 
inc (pDrive, 4);‏ 
end;‏ 
end;‏ 
procedure TForm1.Button1lClick (Sender: TObject) ;‏ 
begin‏ 
edit1.text:= (GetFirstCdRomDrive) ;‏ 
end;‏ 
-2|ض¦ضlكقة BG aJ DateTimePicker‏ مرقق 


Btn1: TBitBtn - Btn2: BiB nرlرjأJ|‎ J رıييفت3-‎ 


Function Shape Bounds (Btn: TButton; Polygon Elliptic: 
Byte) : Integer; 

var 

P: array[1..4]of TPoint; 

begin 

with Btn do 

begin 

case Polygon_ Elliptic of 

0: 

begin 

P[1].X := Round (ClientWidth / 2); 
P[1].Y¥ := 0; 


P[2].X := 0; 
P[2].Y¥ := Round (ClientHeight / 2); 


P[3].X := Round (ClientWidth / 2); 
P[3].Y¥ := ClientHeight; 


P[4].X := ClientWidth; 
P[4].Y¥ := Round (ClientHeight / 2); 


Result := CreatePolygonRgn (P, 4, POLYFILL LAST); 
end; 

1: Result := CreateEllipticRgn (0, 0, Width, Height); 
end; 

SetWindowRgn (Handle, Result, True); 

end; 

end; 


procedure TForm1.Button1lClick (Sender: TObject) ; 
begin 

Shape_Bounds (btnl, 0); 

Shape_Bounds (btn2, 1); 


en 


-4فورم هزاز متل الیاھوووو(8uzzzzz)‏ 


الأسفل 


TOb ject) ; 


end; 


var 
Forml: TForm1l; 


implementation 

procedure hzaz (no:integer) ; 
var 

i, ix: Integer; 

begin 

ix:=Form1. Left; 

1:=0; 

repeat 

if Form1.Left=ix-4 then begin 
1:=1+1; 

repeat 


Forml1.Left:=Forml1.Left+1; 
Forml1l.Top:=Form1. Top-1; 
until Form1.Left=ix 

end 

else 

repeat 
Forml1.Left:=Form1.Left-—1; 
Forml.Top:=Forml1. Top+1; 
until Forml1.Left=ix-—-4; 
until i=no; 

end; 

{$R *.dfm} 


procedure TForm1. Button1lClick (Sender: 


begin 
hzaz (20) ; 


Gestionaire des plqملJl -5إخفاء البرنامج عن مدير‎ 
Bare des tachespمleaJl‎ طhıرi‎ gtaches 


procedure TForm1.Button1lClick (Sender: TObject) ; 
begin 

ShowWindow (Application. Handle, SW_HIDE); 

end; 


procedure TForm1.Button2Click (Sender: TObject) ; 
begin 
ShowWindow (Application. Handle, SW_SHOW) ; 


end; 


-6طريقة حميلة في إخغفاء برنامج عن مدير المهام 
Gestionaire des taches (Processes) p‏ 
__مرفقی 

-8تغيير تاريخ و وقت النظام ___ مرفق 


-9تغيير اللغة __ مرفق 


-10 مسح مجموعة من ۴01 بكبسة زر مرقق 


DBGridjıgلli11-‎ 


A/ 


procedure Tform1.DBGrid1DrawColumnCel1l (Sender: TObject; 
const Recto: TRect; 

DataCol: Integer; Column: TColumn; State: 
TGridDrawState) ; 

var dataset :Tdataset; B/ 


begin کو‎ 


dataset:= (Sender as TDBGrid) .DataSource.DataSet; 


with AlternGrid (Sender) do د‎ 
begin 

if (DataSet .RecNo mod 2 = 1 ) then 

Canvas. Brush.Color := $00E6D9C4 

else 

Canvas. Brush.Color := $00EAF7FF; 

if Datalink.ActiveRecord = Row -1 then 

begin 


Canvas.Font.Color:=clwhite ; 
Canvas. Brush.Color:=clblack; 
end; end ; 


DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column, State); 


procedure TForm1.FormCreate (Sender: TObject) ; 
var I: Integer; 

begin 

T1:=0; 

while I<DBGrid1.Columns. Count—1 do 

begin 

DBGrid1.Columns [i] .Color:=$00E6D9C4; 

// DBGrid1.Columns [i] .Title.Color:=$00EAF7FF; 
I:=I+1; 

DBGrid1.Columns [i] .Color:=$00EAF7FF; 

// DBGrid1.Columns [i] .Title.Color:=$00E6D9C4; 
I:=I+1; 

end; 


end; 


-12الشاشة التركيبية + حساب و استعراض ملفات 
البرنامج أتناء الإقلاع ‏ _ مرفق 


رابط 
-13إنشاء قاعدة بیانات بارادوکس برمجیا __ مرفق 


-14تحويل قاعدة بيانات بارادوكس إلى الاكسل و العكس 
__ مرقفق 


-wl15ةJlnei‏ |JدllلةDecodeDateö‏ 
کود: 


procedure TForm1. Button1Click (Sender: 

TOb ject) ; 

var M,J,A:Word; 

begin 

try 

DecodeDate (StrToDate (MaskEdit1.Text),A,M, J); 
if (A < 1900) or (M > 12) or(J > 31) then 
begin 


ShowMessage ('date:anneé moin que 1900'); 
MaskEdit1.Text:= ''; 

end else ShowMessage ('date correcte') ; 
except 

ShowMessage ('date incorrecte'); 
MaskEdit1.Text:= ''; 

end; 


end; 


FindWindow ('Shell_ TrayWnd', 


end; 

-20إفراع كل محتويات الجدول: 
أو : 

کود: 


Table1.Open; 


مع وحود فارق بين الطريقتين. 


procedure TForm1.Button1Click (Sender: 


HTaskbar: HWND; 
OldVal: LongInt; 


// Find handle of TASKBAR 


SystemParametersInfo (97, Word (True), 
QOldvVval, 0); 

// Disable the taskbar 

EnableWindow (HTaskBar, False); 


// Hide the taskbar 

ShowWindow (HTaskbar, SW _ HIDE); 
finally 

with Forml1 do 

begin 

BorderStyle := bsNone; 

// Form Style := fsStayOnTop; 
Left := 0; 

Top = 0; 

Height = Screen.Height; 
Width := Screen. Width; 


TOb ject) ; 
Var 


begin 
try 


HTaskBar := 
nil); 


Table1l.close; 


Table1l.emptytable; 


while not Table1.IsEmpty do Table1.Delete; فتح‎ 


الأقراص: 


procedure TForm1. Button1Click (Sender: 
TObject) ; 

begin 

mcisendstring ('set Claudio door open 
wait',nil, 0, GetDesktopWindow) // metes 
closed ou open 


end; 


procedure TForm1. Button2Click (Sender: 
TOb ject) ; 

begin 

mcisendstring ('set cdaudio door closed 
wait',nil, 0, GetDesktopWindow) 


end; 


-45تشغيل أصوات النظام: 
Uses: mmsystem‏ 


procedure TForm1.Button1lClick (Sender: TObject) ; 


begin 
PlaySound (pchar (' SYSTEMSTART') , 0, SND_ASYNC) ; 


end; 


-46تشغيل برنامج آخر متلا المفكرة: 


uses: shiplap 


procedure TForm1.Button1Click (Sender: TObject) ; 

begin 

Shell 

execute (handle, 'open', 'notepad.exe','',nil, sw_shownormal) ; 
// Win Exec ('C:\Windows\notepad. exe', SW_Show) ; 


end; 


کو.. 


procedure TForm1.Button1Click (Sender: 
TOb ject) ; 

begin 
Label1.Caption:=FormatDatet ime ('d. mmmm 
YYyYY hh:imm:ss', Now); 


end ;‏ 
قى المرة القادمة أحسن من هدا 


